home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / srcuc.zip / PRUXFS.C < prev    next >
C/C++ Source or Header  |  1991-11-04  |  13KB  |  398 lines
  1. /* -*-C-*-
  2.  
  3. $Header: /scheme/src/microcode/RCS/pruxfs.c,v 9.48 1991/11/04 18:49:26 cph Exp $
  4.  
  5. Copyright (c) 1987-91 Massachusetts Institute of Technology
  6.  
  7. This material was developed by the Scheme project at the Massachusetts
  8. Institute of Technology, Department of Electrical Engineering and
  9. Computer Science.  Permission to copy this software, to redistribute
  10. it, and to use it for any purpose is granted, subject to the following
  11. restrictions and understandings.
  12.  
  13. 1. Any copy made of this software must include this copyright notice
  14. in full.
  15.  
  16. 2. Users of this software agree to make their best efforts (a) to
  17. return to the MIT Scheme project any improvements or extensions that
  18. they make, so that these may be included in future releases; and (b)
  19. to inform MIT of noteworthy uses of this software.
  20.  
  21. 3. All materials developed as a consequence of the use of this
  22. software shall duly acknowledge such use, in accordance with the usual
  23. standards of acknowledging credit in academic research.
  24.  
  25. 4. MIT has made no warrantee or representation that the operation of
  26. this software will be error-free, and MIT is under no obligation to
  27. provide any services, by way of maintenance, update, or otherwise.
  28.  
  29. 5. In conjunction with products arising from the use of this material,
  30. there shall be no use of the name of the Massachusetts Institute of
  31. Technology nor of any adaptation thereof in any advertising,
  32. promotional, or sales literature without prior written consent from
  33. MIT in each case. */
  34.  
  35. /* Unix-specific file-system primitives. */
  36.  
  37. #include "scheme.h"
  38. #include "prims.h"
  39. #include "ux.h"
  40. #include "osfs.h"
  41.  
  42. extern int EXFUN
  43.   (UX_read_file_status, (CONST char * filename, struct stat * s));
  44. extern int EXFUN
  45.   (UX_read_file_status_indirect, (CONST char * filename, struct stat * s));
  46.  
  47. static SCHEME_OBJECT EXFUN (file_attributes_internal, (struct stat * s));
  48. static void EXFUN (file_mode_string, (struct stat * s, char * a));
  49. static char EXFUN (file_type_letter, (struct stat * s));
  50. static void EXFUN (rwx, (unsigned short bits, char * chars));
  51. static SCHEME_OBJECT EXFUN (file_touch, (CONST char * filename));
  52. static void EXFUN (protect_fd, (int fd));
  53.  
  54. #ifndef FILE_TOUCH_OPEN_TRIES
  55. #define FILE_TOUCH_OPEN_TRIES 5
  56. #endif
  57.  
  58. DEFINE_PRIMITIVE ("FILE-MODES", Prim_file_modes, 1, 1,
  59.   "Return mode bits of FILE, as an integer.")
  60. {
  61.   struct stat stat_result;
  62.   PRIMITIVE_HEADER (1);
  63.   PRIMITIVE_RETURN
  64.     ((UX_read_file_status_indirect ((STRING_ARG (1)), (&stat_result)))
  65.      ? (LONG_TO_UNSIGNED_FIXNUM ((stat_result . st_mode) & 07777))
  66.      : SHARP_F);
  67. }
  68.  
  69. DEFINE_PRIMITIVE ("SET-FILE-MODES!", Prim_set_file_modes, 2, 2,
  70.   "Set the mode bits of FILE to MODE.")
  71. {
  72.   PRIMITIVE_HEADER (2);
  73.   if ((UX_chmod ((STRING_ARG (1)), (arg_index_integer (2, 010000)))) < 0)
  74.     error_system_call (errno, syscall_chmod);
  75.   PRIMITIVE_RETURN (SHARP_F);
  76. }
  77.  
  78. DEFINE_PRIMITIVE ("FILE-MOD-TIME", Prim_file_mod_time, 1, 1, 0)
  79. {
  80.   struct stat s;
  81.   PRIMITIVE_HEADER (1);
  82.   PRIMITIVE_RETURN
  83.     ((UX_read_file_status ((STRING_ARG (1)), (&s)))
  84.      ? (long_to_integer (s . st_mtime))
  85.      : SHARP_F);
  86. }
  87.  
  88. DEFINE_PRIMITIVE ("FILE-MOD-TIME-INDIRECT", Prim_file_mod_time_indirect, 1, 1, 0)
  89. {
  90.   struct stat s;
  91.   PRIMITIVE_HEADER (1);
  92.   PRIMITIVE_RETURN
  93.     ((UX_read_file_status_indirect ((STRING_ARG (1)), (&s)))
  94.      ? (long_to_integer (s . st_mtime))
  95.      : SHARP_F);
  96. }
  97.  
  98. /* Returns a vector of 10 items:
  99.  
  100.    0 = #T iff the file is a directory,
  101.        string (name linked to) for symbolic link,
  102.        #F for all other files.
  103.    1 = number of links to the file
  104.    2 = user id, as an unsigned integer
  105.    3 = group id, as an unsigned integer
  106.    4 = last access time of the file
  107.    5 = last modification time of the file
  108.    6 = last change time of the file
  109.    7 = size of the file in bytes
  110.    8 = mode string for the file
  111.    9 = inode number of the file
  112.  
  113.    The file_mode_string stuff was gobbled from GNU Emacs. */
  114.  
  115. #define FILE_ATTRIBUTES_PRIMITIVE(stat_syscall)                \
  116. {                                    \
  117.   struct stat s;                            \
  118.   PRIMITIVE_HEADER (1);                            \
  119.   PRIMITIVE_RETURN                            \
  120.     ((stat_syscall ((STRING_ARG (1)), (&s)))                \
  121.      ? (file_attributes_internal (&s))                    \
  122.      : SHARP_F);                            \
  123. }
  124.  
  125. DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1, 1,
  126.   "Given a file name, return attribute information about the file.\n\
  127. If the file exists and its status information is accessible, the result\n\
  128. is a vector of 10 items (see the reference manual for details).  Otherwise\n\
  129. the result is #F.")
  130.      FILE_ATTRIBUTES_PRIMITIVE (UX_read_file_status)
  131.  
  132. DEFINE_PRIMITIVE ("FILE-ATTRIBUTES-INDIRECT", Prim_file_attributes_indirect, 1, 1,
  133.   "Like FILE-ATTRIBUTES but indirect through symbolic links.")
  134.      FILE_ATTRIBUTES_PRIMITIVE (UX_read_file_status_indirect)
  135.  
  136. static SCHEME_OBJECT
  137. DEFUN (file_attributes_internal, (s), struct stat * s)
  138. {
  139.   SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 10, true));
  140.   SCHEME_OBJECT modes = (allocate_string (10));
  141.   switch ((s -> st_mode) & S_IFMT)
  142.     {
  143.     case S_IFDIR:
  144.       VECTOR_SET (result, 0, SHARP_T);
  145.       break;
  146. #ifdef S_IFLNK
  147.     case S_IFLNK:
  148.       VECTOR_SET (result, 0,
  149.           (char_pointer_to_string
  150.            ((unsigned char *)
  151.             (OS_file_soft_link_p
  152.              ((CONST char *) (STRING_LOC ((ARG_REF (1)), 0)))))));
  153.       break;
  154. #endif
  155.     default:
  156.       VECTOR_SET (result, 0, SHARP_F);
  157.       break;
  158.     }
  159.   VECTOR_SET (result, 1, (long_to_integer (s -> st_nlink)));
  160.   VECTOR_SET (result, 2, (long_to_integer (s -> st_uid)));
  161.   VECTOR_SET (result, 3, (long_to_integer (s -> st_gid)));
  162.   VECTOR_SET (result, 4, (long_to_integer (s -> st_atime)));
  163.   VECTOR_SET (result, 5, (long_to_integer (s -> st_mtime)));
  164.   VECTOR_SET (result, 6, (long_to_integer (s -> st_ctime)));
  165.   VECTOR_SET (result, 7, (long_to_integer (s -> st_size)));
  166.   file_mode_string (s, ((char *) (STRING_LOC (modes, 0))));
  167.   VECTOR_SET (result, 8, modes);
  168.   VECTOR_SET (result, 9, (long_to_integer (s -> st_ino)));
  169.   return (result);
  170. }
  171.  
  172. /* file_mode_string - set file attribute data
  173.  
  174.    File_mode_string converts the data in the st_mode field of file
  175.    status block `s' to a 10 character attribute string, which it
  176.    stores in the block that `a' points to.
  177.  
  178.    This attribute string is modelled after the string produced by the
  179.    Berkeley ls.
  180.  
  181.    As usual under Unix, the elements of the string are numbered from
  182.    0.  Their meanings are:
  183.  
  184.    0    File type.  'd' for directory, 'c' for character special, 'b'
  185.     for block special, 'm' for multiplex, 'l' for symbolic link,
  186.     's' for socket, 'p' for fifo, '-' for any other file type
  187.    1    'r' if the owner may read, '-' otherwise.
  188.    2    'w' if the owner may write, '-' otherwise.
  189.    3    'x' if the owner may execute, 's' if the file is set-user-id,
  190.     '-' otherwise.  'S' if the file is set-user-id, but the
  191.     execute bit isn't set.  (sys V `feature' which helps to catch
  192.     screw case.)
  193.    4    'r' if group members may read, '-' otherwise.
  194.    5    'w' if group members may write, '-' otherwise.
  195.    6    'x' if group members may execute, 's' if the file is
  196.     set-group-id, '-' otherwise.  'S' if it is set-group-id but
  197.     not executable.
  198.    7    'r' if any user may read, '-' otherwise.
  199.    8    'w' if any user may write, '-' otherwise.
  200.    9    'x' if any user may execute, 't' if the file is "sticky" (will
  201.     be retained in swap space after execution), '-' otherwise. */
  202.  
  203. static void
  204. DEFUN (file_mode_string, (s, a), struct stat * s AND char * a)
  205. {
  206.   (a[0]) = (file_type_letter (s));
  207.   rwx ((((s -> st_mode) & 0700) << 0), (& (a [1])));
  208.   rwx ((((s -> st_mode) & 0070) << 3), (& (a [4])));
  209.   rwx ((((s -> st_mode) & 0007) << 6), (& (a [7])));
  210. #ifdef S_ISUID
  211.   if (((s -> st_mode) & S_ISUID) != 0)
  212.     (a[3]) = (((a[3]) == 'x') ? 's' : 'S');
  213. #endif
  214. #ifdef S_ISGID
  215.   if (((s -> st_mode) & S_ISGID) != 0)
  216.     (a[6]) = (((a [6]) == 'x') ? 's' : 'S');
  217. #endif
  218. #ifdef S_ISVTX
  219.   if (((s -> st_mode) & S_ISVTX) != 0)
  220.     (a[9]) = (((a [9]) == 'x') ? 't' : 'T');
  221. #endif
  222. }
  223.  
  224. static char
  225. DEFUN (file_type_letter, (s), struct stat * s)
  226. {
  227.   switch ((s -> st_mode) & S_IFMT)
  228.     {
  229.     case S_IFDIR:
  230.       return ('d');
  231.     case S_IFCHR:
  232.       return ('c');
  233.     case S_IFBLK:
  234.       return ('b');
  235. #ifdef S_IFLNK
  236.     case S_IFLNK:
  237.       return ('l');
  238. #endif
  239. #ifdef S_IFMPC
  240. /* These do not seem to exist */
  241.     case S_IFMPC:
  242.     case S_IFMPB:
  243.       return ('m');
  244. #endif
  245. #ifdef S_IFSOCK
  246.     case S_IFSOCK:
  247.       return ('s');
  248. #endif
  249. #ifdef S_IFIFO
  250.     case S_IFIFO:
  251.       return ('p');
  252. #endif
  253. #ifdef S_IFNWK /* hp-ux hack */
  254.     case S_IFNWK:
  255.       return ('n');
  256. #endif
  257.     default:
  258.       return ('-');
  259.     }
  260. }
  261.  
  262. static void
  263. DEFUN (rwx, (bits, chars), unsigned short bits AND char * chars)
  264. {
  265.   (chars[0]) = (((bits & S_IREAD) != 0)  ? 'r' : '-');
  266.   (chars[1]) = (((bits & S_IWRITE) != 0) ? 'w' : '-');
  267.   (chars[2]) = (((bits & S_IEXEC) != 0)  ? 'x' : '-');
  268. }
  269.  
  270. DEFINE_PRIMITIVE ("FILE-TOUCH", Prim_file_touch, 1, 1,
  271.   "Given a file name, change the times of the file to the current time.\n\
  272. If the file does not exist, create it.\n\
  273. Both the access time and modification time are changed.\n\
  274. Return #F if the file existed and its time was modified.\n\
  275. Otherwise the file did not exist and it was created.")
  276. {
  277.   PRIMITIVE_HEADER (1);
  278.   PRIMITIVE_RETURN (file_touch ((CONST char *) (STRING_ARG (1))));
  279. }
  280.  
  281. static SCHEME_OBJECT
  282. DEFUN (file_touch, (filename), CONST char * filename)
  283. {
  284.   int fd;
  285.   transaction_begin ();
  286.   {
  287.     unsigned int count = 0;
  288.     while (1)
  289.       {
  290.     count += 1;
  291.     /* Use O_EXCL to prevent overwriting existing file. */
  292.     fd = (UX_open (filename, (O_RDWR | O_CREAT | O_EXCL), MODE_REG));
  293.     if (fd >= 0)
  294.       {
  295.         protect_fd (fd);
  296.         transaction_commit ();
  297.         return (SHARP_T);
  298.       }
  299.     if (errno == EEXIST)
  300.       {
  301.         fd = (UX_open (filename, O_RDWR, MODE_REG));
  302.         if (fd >= 0)
  303.           {
  304.         protect_fd (fd);
  305.         break;
  306.           }
  307.         else if ((errno == ENOENT) || (errno == ESTALE))
  308.           continue;
  309.       }
  310.     if (count >= FILE_TOUCH_OPEN_TRIES)
  311.       error_system_call (errno, syscall_open);
  312.       }
  313.   }
  314.   {
  315.     struct stat file_status;
  316.     STD_VOID_SYSTEM_CALL (syscall_fstat, (UX_fstat (fd, (&file_status))));
  317.     if (((file_status . st_mode) & S_IFMT) != S_IFREG)
  318.       error_bad_range_arg (1);
  319.     /* CASE 3: file length of 0 needs special treatment. */
  320.     if ((file_status . st_size) == 0)
  321.       {
  322.     char buf [1];
  323.     (buf[0]) = '\0';
  324.     STD_VOID_SYSTEM_CALL (syscall_write, (UX_write (fd, buf, 1)));
  325. #ifdef HAVE_TRUNCATE
  326.     STD_VOID_SYSTEM_CALL (syscall_ftruncate, (UX_ftruncate (fd, 0)));
  327.     transaction_commit ();
  328. #else /* not HAVE_TRUNCATE */
  329.     transaction_commit ();
  330.     fd = (UX_open (filename, (O_WRONLY | O_TRUNC), MODE_REG));
  331.     if (fd >= 0)
  332.       STD_VOID_SYSTEM_CALL (syscall_close, (UX_close (fd)));
  333. #endif /* HAVE_TRUNCATE */
  334.     return (SHARP_F);
  335.       }
  336.   }
  337.   /* CASE 4: read, then write back the first byte in the file. */
  338.   {
  339.     char buf [1];
  340.     int scr;
  341.     STD_UINT_SYSTEM_CALL (syscall_read, scr, (UX_read (fd, buf, 1)));
  342.     if (scr > 0)
  343.       {
  344.     STD_VOID_SYSTEM_CALL (syscall_lseek, (UX_lseek (fd, 0, SEEK_SET)));
  345.     STD_VOID_SYSTEM_CALL (syscall_write, (UX_write (fd, buf, 1)));
  346.       }
  347.   }
  348.   transaction_commit ();
  349.   return (SHARP_F);
  350. }
  351.  
  352. static void
  353. DEFUN (protect_fd_close, (ap), PTR ap)
  354. {
  355.   UX_close (* ((int *) ap));
  356. }
  357.  
  358. static void
  359. DEFUN (protect_fd, (fd), int fd)
  360. {
  361.   int * p = (dstack_alloc (sizeof (int)));
  362.   (*p) = fd;
  363.   transaction_record_action (tat_always, protect_fd_close, p);
  364. }
  365.  
  366. DEFINE_PRIMITIVE ("SET-FILE-TIMES!", Prim_set_file_times, 3, 3,
  367.   "Change the access and modification times of FILE.\n\
  368. The second and third arguments are the respective times;\n\
  369. they are integers are the times in seconds since 00:00:00 GMT, Jan. 1, 1970\n\
  370. The file must exist and you must be the owner (or superuser).")
  371. {
  372.   PRIMITIVE_HEADER (3);
  373.   {
  374.     struct utimbuf times;
  375.     
  376.     times.actime = arg_integer (2);
  377.     times.modtime = arg_integer (3);
  378.     STD_VOID_SYSTEM_CALL(syscall_utime, (UX_utime ((STRING_ARG (1)), ×)));
  379.     PRIMITIVE_RETURN (SHARP_F);
  380.   }
  381. }
  382.  
  383. DEFINE_PRIMITIVE ("FILE-EQ?", Prim_file_eq_p, 2, 2,
  384.   "True iff the two file arguments are the same file.")
  385. {
  386.   PRIMITIVE_HEADER (2);
  387.   {
  388.     struct stat s1;
  389.     struct stat s2;
  390.     PRIMITIVE_RETURN
  391.       (BOOLEAN_TO_OBJECT
  392.        ((UX_read_file_status ((STRING_ARG (1)), (&s1)))
  393.     && (UX_read_file_status ((STRING_ARG (2)), (&s2)))
  394.     && ((s1 . st_dev) == (s2 . st_dev))
  395.     && ((s1 . st_ino) == (s2 . st_ino))));
  396.   }
  397. }
  398.